home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tpio24.zip / DATEDEMO.INC < prev    next >
Text File  |  1993-01-04  |  6KB  |  171 lines
  1. { File = DATEDEMO.INC -- Include file for IO21DEMO.PAS -- 10/9/86 }
  2.  
  3. procedure date_demo ;
  4.   { demonstrates the things you can do with dates }
  5.  
  6. const
  7.     null_jul : juldate = (yr:0 ; day:0) ;
  8.     blanks   : string[10] = '          ' ;
  9.  
  10. var
  11.     date1,
  12.     date2,
  13.     temp1,
  14.     temp2    : date ;
  15.     workjul  : juldate ;
  16.     juldtst  : juldatestring ;
  17.     dtst     : datestring ;
  18.     fds      : fulldatestring ;
  19.     diff     : string[7] ;
  20.     n        : integer ;
  21.     prevfld  : integer ;
  22.  
  23. { ==================== }
  24.  
  25. procedure display_diff ;
  26.   var
  27.     n : integer ;
  28.   begin
  29.     if equal_date (date1,null_date)
  30.     or equal_date (date2,null_date) then
  31.         for n := 20 to 21 do
  32.             clrline (16,n)
  33.     else if equal_date(date1,date2) then
  34.       begin
  35.         write_str ('The dates are equal',16,20) ;
  36.         write ('':20) ;
  37.         clrline (16,21)
  38.       end
  39.     else
  40.       begin
  41.         write_date (date1,16,20) ;
  42.         if greater_date(date1,date2) = 1 then
  43.           begin
  44.             write (' is later than ') ;
  45.             temp1 := date2 ;
  46.             temp2 := date1
  47.           end
  48.         else
  49.           begin
  50.             write (' is earlier than ') ;
  51.             temp1 := date1 ;
  52.             temp2 := date2
  53.           end ;
  54.         dtst := mk_dt_st(date2) ;
  55.         write (dtst) ;
  56.         write ('':20) ;
  57.         write_str ('There are ',16,21) ;
  58.         str(date_diff(temp1,temp2):7:0,diff) ;
  59.         diff := purgech(diff,' ') ;
  60.         write (diff,' days (about ') ;
  61.         write (month_diff(temp1,temp2)) ;
  62.         write (' months) between the two dates.') ;
  63.         write ('':10)
  64.       end
  65.   end ;
  66.  
  67. { ==================== }
  68.  
  69. begin { proc date_demo }
  70.     clrscr ;
  71.     write_str('Enter two dates, press ESC to quit.',16,1) ;
  72.     write_str('DATE 1               DATE 2',32,3) ;
  73.     write_str('------               ------',32,4) ;
  74.     write_str('==>                  ==>',26,6) ;
  75.     write_str('Julian date:',17,10) ;
  76.     write_str('Next day:',20,12) ;
  77.     write_str('Previous day:',16,14) ;
  78.     write_str('Leap year?',19,16) ;
  79.     write_str('=============================================',16,18) ;
  80.     date1 := null_date ;
  81.     date2 := null_date ;
  82.     fld := 1 ;
  83.     repeat
  84.         case fld of
  85.          1: begin
  86.               prevfld := 1 ;
  87.               read_date (date1,30,6) ;
  88.               if (date1.yr > 0) and (date1.yr < 1563) then
  89.                 begin
  90.                   show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
  91.                   date1.mo := 0 ; date1.dy := 0 ; date1.yr := 0 ;
  92.                   write_date (date1,30,6) ;
  93.                   fld := 1
  94.                 end ;
  95.               if not (equal_date(date1,null_date)) then
  96.                 begin
  97.                   fds := build_full_date_str (date1) ;
  98.                   write_str (fds,16,8) ;
  99.                   greg_to_jul (date1,workjul) ;
  100.                   juldtst := mk_jul_dt_st (workjul) ;
  101.                   write_str (juldtst,32,10) ;
  102.                   temp1 := date1 ;
  103.                   next_day (temp1) ;
  104.                   write_date (temp1,30,12) ;
  105.                   temp1 := date1 ;
  106.                   prev_day (temp1) ;
  107.                   write_date (temp1,30,14) ;
  108.                   write_bool (leapyear(date1.yr),32,16) ;
  109.                 end
  110.               else
  111.                 begin
  112.                   gotoxy(16,8) ; write('':fdslen) ;
  113.                   for n := 8 to 16 do
  114.                       write_str (blanks,30,n)
  115.                 end ;
  116.               display_diff
  117.             end ; { 1 }
  118.          2: begin
  119.               prevfld := 2 ;
  120.               read_date (date2,51,6) ;
  121.               if (date2.yr > 0) and (date2.yr < 1563) then
  122.                 begin
  123.                   show_msg ('CAN''T HANDLE YEAR LESS THAN 1563') ;
  124.                   date2.mo := 0 ; date2.dy := 0 ; date2.yr := 0 ;
  125.                   write_date (date2,51,6) ;
  126.                   fld := 2
  127.                 end ;
  128.               if not (equal_date(date2,null_date)) then
  129.                 begin
  130.                   fds := build_full_date_str (date2) ;
  131.                   write_str (fds,47,8) ;
  132.                   greg_to_jul (date2,workjul) ;
  133.                   juldtst := mk_jul_dt_st (workjul) ;
  134.                   write_str (juldtst,53,10) ;
  135.                   temp1 := date2 ;
  136.                   next_day (temp1) ;
  137.                   write_date (temp1,51,12) ;
  138.                   temp1 := date2 ;
  139.                   prev_day (temp1) ;
  140.                   write_date (temp1,51,14) ;
  141.                   write_bool (leapyear(date2.yr),53,16) ;
  142.                 end
  143.               else
  144.                 begin
  145.                   gotoxy (47,8) ; write ('':fdslen) ;
  146.                   for n := 10 to 16 do
  147.                       write_str (blanks,51,n)
  148.                 end;
  149.               display_diff
  150.             end ; { 2 }
  151.          3: begin
  152.               prevfld := 3 ;
  153.               pause
  154.             end
  155.         end ; { case }
  156.         if fld < 1 then                           { can't go back from 1 }
  157.             fld := 1
  158.         else if (fld > 3) and (fld < maxint) then
  159.           begin
  160.             if prevfld = 3 then
  161.                 fld := 1                          { back to beginning from 3 }
  162.             else
  163.                 fld := 3                          { trap next_page }
  164.           end
  165.     until fld = maxint ;
  166.     fld := 1  { reset FLD for calling proc }
  167. end ; { proc date_demo }
  168.  
  169. { ------ EOF DATEDEMO.INC ------------------------------------ }
  170.  
  171.